#https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv
library(readxl)
library(shiny)
library(Lahman)
library(tidyverse)
library(plotly)
library(albersusa)
Exercise 1
#Step 1
gettingPopulation <- read_excel("../final project/gettingPopulation.xlsx", skip = 3)
## New names:
## * `` -> ...1
## * `` -> ...2
ddd <- read_csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv")
## Parsed with column specification:
## cols(
## date = col_date(format = ""),
## county = col_character(),
## state = col_character(),
## fips = col_character(),
## cases = col_double(),
## deaths = col_double()
## )
gettingPopulation <- gettingPopulation %>%
select("...1", "...2", "43647")
gettingPopulation <- rename(gettingPopulation, "Rank" = "...1", "CountryState" =
"...2", "Population" = "43647")
covid19 <- ddd %>%
select(date, county, state, cases)
gettingPopulation <- gettingPopulation %>%
separate(CountryState, into = c("Country", "State"), sep=", ")
gettingPopulation <- gettingPopulation %>%
separate(Country, into = c("County", "Junk"), sep = " ")
## Warning: Expected 2 pieces. Additional pieces discarded in 6 rows [8, 26, 53,
## 68, 79, 94].
gettingPopulation <- gettingPopulation %>%
select(County, State, Population)
gettingPopulation <- na.omit(gettingPopulation)
combined <- gettingPopulation %>%
left_join(covid19, by = c("County" = "county", "State" = "state"))
combined <- combined %>%
mutate(infection_rates_percentage = (cases / Population) * 100)
Exercise 2
#Step 2
us_county <- counties_sf("laea")
my_map_theme <-function(){
theme(panel.background=element_blank(),
axis.text=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank())
}
ggplot(us_county) +
geom_sf(size = 0.1) +
my_map_theme()

covidLastDay <- combined %>% filter(date==as.Date("2020-11-17"))
mapdd <- us_county %>%
left_join(covidLastDay, by=c("name" = "County"))
ggplot(mapdd) +
geom_sf(aes(fill = infection_rates_percentage),size=0.1) +
scale_fill_continuous("COVID-19's \nInfection rate (%)", low="blue", high="red") +
labs(title = "Infection rates in\nfrom USA's counties\nat 2020-11-17") +
my_map_theme()

v <- ggplot(mapdd) +
geom_sf(aes(fill = infection_rates_percentage),size=0.1) +
scale_fill_continuous("COVID-19's \nInfection rate (%)", low="blue", high="red") +
labs(title = "Infection rates in\nfrom USA's counties\nat 2020-11-17") +
my_map_theme()
ggplotly(v) %>%
style(hoveron = "fill")
Exercise 3
#Step 3
covidAnalyze <- function(mydate, varget){
varset <- enquo(varget)
selected <- combined %>%
select(County, State, date, var = !!varset)
covidLastDay <- selected %>%
filter(date==as.Date(mydate))
mapdd <- us_county %>%
left_join(covidLastDay, by=c("name" = "County"))
v <- ggplot(mapdd) +
geom_sf(aes(fill = var),size=0.1) +
scale_fill_continuous("Showing number of cases or rate of infections in %",low="blue", high="red") +
my_map_theme()
ggplotly(v) %>%
style(hoveron = "fill")
}
Exercise 4
#Step 4
ui <- fluidPage(
titlePanel("Analyze about USA's counties during COVID-19"),
sidebarLayout(
sidebarPanel(
selectInput("varset",
"Major elements in the COVID-19's map:",
choices = list("Infection Rate" = "infection_rates_percentage",
"Number of COVID-19's cases" = "cases"),
selected = "cases"),
sliderInput("mydate",
"Select a date to display:",
min = as.Date("2020-03-05","%Y-%m-%d"),
max = as.Date("2020-11-25","%Y-%m-%d"),
value = as.Date("2020-05-20"),
timeFormat="%m-%d")
),
mainPanel(
plotlyOutput("map")
)
)
)
server <- function(input, output){
output$map <- renderPlotly({
covidAnalyze(input$mydate, input$varset)
})
}
shinyApp(ui = ui, server = server)
## PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents
…
LS0tCnRpdGxlOiAiRmluYWwgTWFwIgphdXRob3I6ICJTYW5naGEgWW9vbiIKZGF0ZTogImByIFN5cy5EYXRlKClgIgpvdXRwdXQ6IG9wZW5pbnRybzo6bGFiX3JlcG9ydAotLS0KCmBgYHtyIGxvYWQtcGFja2FnZXMsIG1lc3NhZ2U9RkFMU0V9CiNodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vbnl0aW1lcy9jb3ZpZC0xOS1kYXRhL21hc3Rlci91cy1jb3VudGllcy5jc3YKbGlicmFyeShyZWFkeGwpCmxpYnJhcnkoc2hpbnkpCmxpYnJhcnkoTGFobWFuKQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShwbG90bHkpCmxpYnJhcnkoYWxiZXJzdXNhKQpgYGAKCiMjIyBFeGVyY2lzZSAxCgpgYGB7ciBjb2RlLWNodW5rLWxhYmVsfQojU3RlcCAxCmdldHRpbmdQb3B1bGF0aW9uIDwtIHJlYWRfZXhjZWwoIi4uL2ZpbmFsIHByb2plY3QvZ2V0dGluZ1BvcHVsYXRpb24ueGxzeCIsIHNraXAgPSAzKQpkZGQgPC0gcmVhZF9jc3YoImh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9ueXRpbWVzL2NvdmlkLTE5LWRhdGEvbWFzdGVyL3VzLWNvdW50aWVzLmNzdiIpCgpnZXR0aW5nUG9wdWxhdGlvbiA8LSBnZXR0aW5nUG9wdWxhdGlvbiAlPiUKICBzZWxlY3QoIi4uLjEiLCAiLi4uMiIsICI0MzY0NyIpCgpnZXR0aW5nUG9wdWxhdGlvbiA8LSByZW5hbWUoZ2V0dGluZ1BvcHVsYXRpb24sICJSYW5rIiA9ICIuLi4xIiwgIkNvdW50cnlTdGF0ZSIgPSAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIi4uLjIiLCAiUG9wdWxhdGlvbiIgPSAiNDM2NDciKQoKY292aWQxOSA8LSBkZGQgJT4lCiAgc2VsZWN0KGRhdGUsIGNvdW50eSwgc3RhdGUsIGNhc2VzKQoKZ2V0dGluZ1BvcHVsYXRpb24gPC0gZ2V0dGluZ1BvcHVsYXRpb24gJT4lCiAgc2VwYXJhdGUoQ291bnRyeVN0YXRlLCBpbnRvID0gYygiQ291bnRyeSIsICJTdGF0ZSIpLCBzZXA9IiwgIikKCmdldHRpbmdQb3B1bGF0aW9uIDwtIGdldHRpbmdQb3B1bGF0aW9uICU+JQogIHNlcGFyYXRlKENvdW50cnksIGludG8gPSBjKCJDb3VudHkiLCAiSnVuayIpLCBzZXAgPSAiICIpCgpnZXR0aW5nUG9wdWxhdGlvbiA8LSBnZXR0aW5nUG9wdWxhdGlvbiAlPiUKICBzZWxlY3QoQ291bnR5LCBTdGF0ZSwgUG9wdWxhdGlvbikKCmdldHRpbmdQb3B1bGF0aW9uIDwtIG5hLm9taXQoZ2V0dGluZ1BvcHVsYXRpb24pCgpjb21iaW5lZCA8LSBnZXR0aW5nUG9wdWxhdGlvbiAlPiUKICBsZWZ0X2pvaW4oY292aWQxOSwgYnkgPSBjKCJDb3VudHkiID0gImNvdW50eSIsICJTdGF0ZSIgPSAic3RhdGUiKSkKCmNvbWJpbmVkIDwtIGNvbWJpbmVkICU+JQogIG11dGF0ZShpbmZlY3Rpb25fcmF0ZXNfcGVyY2VudGFnZSA9IChjYXNlcyAvIFBvcHVsYXRpb24pICogMTAwKQoKCmBgYAojIyMgRXhlcmNpc2UgMgpgYGB7cn0KI1N0ZXAgMgp1c19jb3VudHkgPC0gY291bnRpZXNfc2YoImxhZWEiKQoKbXlfbWFwX3RoZW1lIDwtZnVuY3Rpb24oKXsKICB0aGVtZShwYW5lbC5iYWNrZ3JvdW5kPWVsZW1lbnRfYmxhbmsoKSwKICAgICAgICBheGlzLnRleHQ9ZWxlbWVudF9ibGFuaygpLAogICAgICAgIGF4aXMudGlja3M9ZWxlbWVudF9ibGFuaygpLAogICAgICAgIGF4aXMudGl0bGU9ZWxlbWVudF9ibGFuaygpKQp9CmdncGxvdCh1c19jb3VudHkpICsKICBnZW9tX3NmKHNpemUgPSAwLjEpICsKICBteV9tYXBfdGhlbWUoKQoKY292aWRMYXN0RGF5IDwtIGNvbWJpbmVkICU+JSBmaWx0ZXIoZGF0ZT09YXMuRGF0ZSgiMjAyMC0xMS0xNyIpKQoKbWFwZGQgPC0gdXNfY291bnR5ICU+JQogIGxlZnRfam9pbihjb3ZpZExhc3REYXksIGJ5PWMoIm5hbWUiID0gIkNvdW50eSIpKQoKZ2dwbG90KG1hcGRkKSArCiAgZ2VvbV9zZihhZXMoZmlsbCA9IGluZmVjdGlvbl9yYXRlc19wZXJjZW50YWdlKSxzaXplPTAuMSkgKwogIHNjYWxlX2ZpbGxfY29udGludW91cygiQ09WSUQtMTkncyBcbkluZmVjdGlvbiByYXRlICglKSIsIGxvdz0iYmx1ZSIsIGhpZ2g9InJlZCIpICsKICBsYWJzKHRpdGxlID0gIkluZmVjdGlvbiByYXRlcyBpblxuZnJvbSBVU0EncyBjb3VudGllc1xuYXQgMjAyMC0xMS0xNyIpICsKICBteV9tYXBfdGhlbWUoKQoKdiA8LSBnZ3Bsb3QobWFwZGQpICsgCiAgZ2VvbV9zZihhZXMoZmlsbCA9IGluZmVjdGlvbl9yYXRlc19wZXJjZW50YWdlKSxzaXplPTAuMSkgKwogIHNjYWxlX2ZpbGxfY29udGludW91cygiQ09WSUQtMTkncyBcbkluZmVjdGlvbiByYXRlICglKSIsIGxvdz0iYmx1ZSIsIGhpZ2g9InJlZCIpICsKICBsYWJzKHRpdGxlID0gIkluZmVjdGlvbiByYXRlcyBpblxuZnJvbSBVU0EncyBjb3VudGllc1xuYXQgMjAyMC0xMS0xNyIpICsKICBteV9tYXBfdGhlbWUoKQoKZ2dwbG90bHkodikgJT4lCiAgc3R5bGUoaG92ZXJvbiA9ICJmaWxsIikKYGBgCgoKCiMjIyBFeGVyY2lzZSAzCmBgYHtyfQojU3RlcCAzCmNvdmlkQW5hbHl6ZSA8LSBmdW5jdGlvbihteWRhdGUsIHZhcmdldCl7CiAgdmFyc2V0IDwtIGVucXVvKHZhcmdldCkKICBzZWxlY3RlZCA8LSBjb21iaW5lZCAlPiUKICAgIHNlbGVjdChDb3VudHksIFN0YXRlLCBkYXRlLCB2YXIgPSAhIXZhcnNldCkKCiAgY292aWRMYXN0RGF5IDwtIHNlbGVjdGVkICU+JSAKICAgIGZpbHRlcihkYXRlPT1hcy5EYXRlKG15ZGF0ZSkpCgogIG1hcGRkIDwtIHVzX2NvdW50eSAlPiUKICAgIGxlZnRfam9pbihjb3ZpZExhc3REYXksIGJ5PWMoIm5hbWUiID0gIkNvdW50eSIpKQogIAogIHYgPC0gZ2dwbG90KG1hcGRkKSArCiAgICBnZW9tX3NmKGFlcyhmaWxsID0gdmFyKSxzaXplPTAuMSkgKwogICAgc2NhbGVfZmlsbF9jb250aW51b3VzKCJTaG93aW5nIG51bWJlciBvZiBjYXNlcyBvciByYXRlIG9mIGluZmVjdGlvbnMgaW4gJSIsbG93PSJibHVlIiwgaGlnaD0icmVkIikgKwogICAgbXlfbWFwX3RoZW1lKCkKICAKICBnZ3Bsb3RseSh2KSAlPiUKICAgIHN0eWxlKGhvdmVyb24gPSAiZmlsbCIpCn0KCmBgYAoKCgojIyMgRXhlcmNpc2UgNApgYGB7cn0KI1N0ZXAgNAp1aSA8LSBmbHVpZFBhZ2UoCiAgCiAgdGl0bGVQYW5lbCgiQW5hbHl6ZSBhYm91dCBVU0EncyBjb3VudGllcyBkdXJpbmcgQ09WSUQtMTkiKSwKICAKICBzaWRlYmFyTGF5b3V0KAogICAgc2lkZWJhclBhbmVsKAogICAgICBzZWxlY3RJbnB1dCgidmFyc2V0IiwKICAgICAgICAgICAgICAgICAgIk1ham9yIGVsZW1lbnRzIGluIHRoZSBDT1ZJRC0xOSdzIG1hcDoiLAogICAgICAgICAgICAgICAgICBjaG9pY2VzID0gbGlzdCgiSW5mZWN0aW9uIFJhdGUiID0gImluZmVjdGlvbl9yYXRlc19wZXJjZW50YWdlIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIk51bWJlciBvZiBDT1ZJRC0xOSdzIGNhc2VzIiA9ICJjYXNlcyIpLAogICAgICAgICAgICAgICAgICBzZWxlY3RlZCA9ICJjYXNlcyIpLAogICAgICBzbGlkZXJJbnB1dCgibXlkYXRlIiwKICAgICAgICAgICAgICAgICAiU2VsZWN0IGEgZGF0ZSB0byBkaXNwbGF5OiIsCiAgICAgICAgICAgICAgICAgbWluID0gYXMuRGF0ZSgiMjAyMC0wMy0wNSIsIiVZLSVtLSVkIiksCiAgICAgICAgICAgICAgICAgbWF4ID0gYXMuRGF0ZSgiMjAyMC0xMS0yNSIsIiVZLSVtLSVkIiksCiAgICAgICAgICAgICAgICAgdmFsdWUgPSBhcy5EYXRlKCIyMDIwLTA1LTIwIiksCiAgICAgICAgICAgICAgICAgdGltZUZvcm1hdD0iJW0tJWQiKQogICAgICApLAogICAgCiAgICBtYWluUGFuZWwoCiAgICAgIHBsb3RseU91dHB1dCgibWFwIikKICAgICkKICAgICAgICAgICAgICAgICAgCiAgICApCikKCnNlcnZlciA8LSBmdW5jdGlvbihpbnB1dCwgb3V0cHV0KXsKICBvdXRwdXQkbWFwIDwtIHJlbmRlclBsb3RseSh7CiAgICBjb3ZpZEFuYWx5emUoaW5wdXQkbXlkYXRlLCBpbnB1dCR2YXJzZXQpCiAgfSkKfQoKc2hpbnlBcHAodWkgPSB1aSwgc2VydmVyID0gc2VydmVyKQpgYGAKCi4uLgoK